﻿namespace FML

#light

module WriterT =
 module Option = 
 
  open WriterM
  open OptionM
  open Monoid
  
 
  type WriterOptionT<'a, 's> = WriterOptionT of ('a * 's) option

  let run (WriterOptionT x ) = x

  type IWriterOptionTrans<'s> = interface
    abstract Bind : WriterOptionT<'a, 's> * ('a -> WriterOptionT<'b, 's>) -> WriterOptionT<'b, 's>
    abstract Let :  'a * ('a ->  WriterOptionT<'b, 's>) -> WriterOptionT<'b, 's>
    abstract Return : 'a -> WriterOptionT<'a, 's>
    abstract Delay : f:(unit -> WriterOptionT<'a, 's>) -> WriterOptionT<'a, 's>
    abstract Lift : a:'a option -> WriterOptionT<'a, 's> 
  end
  
  type WriterOptionBuilder<'s>(optionM : IOptionMonad, monoid : Monoid<'s>) = class end
    with interface IWriterOptionTrans<'s> with
                member s.Bind(m, f) =  WriterOptionT (optionM { let! (a', s') = run  m
                                                                let! (a'', s'') = run (f a')
                                                                return (a'', monoid.Append s' s'')
                                                              }) 
                member s.Let(a, f) =   f a
                member s.Return a = WriterOptionT (optionM.Return((a, monoid.Empty() )))
                member s.Delay f = f()
                member s.Lift(m) = WriterOptionT ( optionM { let! m' = m
                                                             return (m', monoid.Empty() )
                                                           })

  let WriterOptionT (monoid : Monoid<'s>) = new WriterOptionBuilder<'s>(optionM, monoid) :>  IWriterOptionTrans<'s>
 
 
 module List = 
 
  open WriterM
  open ListM
  open Monoid
  
 
  type WriterListT<'a, 's> = WriterListT of ('a * 's) list

  let run (WriterListT x ) = x

  type IWriterListTrans<'s> = interface
    abstract Bind : WriterListT<'a, 's> * ('a -> WriterListT<'b, 's>) -> WriterListT<'b, 's>
    abstract Let :  'a * ('a ->  WriterListT<'b, 's>) -> WriterListT<'b, 's>
    abstract Return : 'a -> WriterListT<'a, 's>
    abstract Delay : f:(unit -> WriterListT<'a, 's>) -> WriterListT<'a, 's>
    abstract Lift : a:'a list -> WriterListT<'a, 's> 
  end
  
  type WriterListBuilder<'s>(listM : IListMonad, monoid : Monoid<'s>) = class end
    with interface IWriterListTrans<'s> with
                member s.Bind(m, f) =  WriterListT (listM { let! (a', s') = run  m
                                                            let! (a'', s'') = run (f a')
                                                            return (a'', monoid.Append s' s'')
                                                          }) 
                member s.Let(a, f) =   f a
                member s.Return a = WriterListT (listM.Return((a, monoid.Empty() )))
                member s.Delay f = f()
                member s.Lift(m) = WriterListT ( listM { let! m' = m
                                                         return (m', monoid.Empty() )
                                                       })

  let WriterListT (monoid : Monoid<'s>) = new WriterListBuilder<'s>(listM, monoid) :>  IWriterListTrans<'s>
 
 module Error = 
 
  open WriterM
  open ErrorM
  open Monoid
  
 
  type WriterErrorT<'l, 'r, 's> = WriterErrorT of Either<'l, ('r * 's)>

  let run (WriterErrorT x ) = x

  type IWriterErrorTrans<'s> = interface
    abstract Bind : WriterErrorT<'l, 'a, 's> * ('a -> WriterErrorT<'l, 'b, 's>) -> WriterErrorT<'l, 'b, 's>
    abstract Let :  'a * ('a ->  WriterErrorT<'l, 'b, 's>) -> WriterErrorT<'l, 'b, 's>
    abstract Return : 'a -> WriterErrorT<'l, 'a, 's>
    abstract Delay : f:(unit -> WriterErrorT<'l, 'a, 's>) -> WriterErrorT<'l, 'a, 's>
    abstract Lift : a:Either<'l, 'r> -> WriterErrorT<'l, 'r, 's>
  end
  
  type WriterErrorBuilder<'s>(errorM : IErrorMonad, monoid : Monoid<'s>) = class end
    with interface IWriterErrorTrans<'s> with
                member s.Bind(m, f) =  WriterErrorT (errorM { let! (a', s') = run  m
                                                              let! (a'', s'') = run (f a')
                                                              return (a'', monoid.Append s' s'')
                                                          }) 
                member s.Let(a, f) =   f a
                member s.Return a = WriterErrorT (errorM.Return((a, monoid.Empty() )))
                member s.Delay f = f()
                member s.Lift(m) = WriterErrorT ( errorM { let! m' = m
                                                         return (m', monoid.Empty() )
                                                       })

  let WriterErrorT (monoid : Monoid<'s>) = new WriterErrorBuilder<'s>(errorM, monoid) :>  IWriterErrorTrans<'s>
 

 module Reader = 
 
  open WriterM
  open ReaderM
  open Monoid
  
 
  type WriterReaderT<'r, 's, 'env> = WriterReaderT of Reader<('r * 's), 'env>

  let run (WriterReaderT x ) = x

  type IWriterReaderTrans<'s> = interface
    abstract Bind : WriterReaderT<'a, 's, 'env> * ('a -> WriterReaderT<'b, 's, 'env>) -> WriterReaderT<'b, 's, 'env>
    abstract Let :  'a * ('a ->  WriterReaderT<'b, 's, 'env>) -> WriterReaderT<'b, 's, 'env>
    abstract Return : 'a -> WriterReaderT<'a, 's, 'env>
    abstract Delay : f:(unit -> WriterReaderT<'a, 's, 'env>) -> WriterReaderT<'a, 's, 'env>
    abstract Lift : a: Reader<'a, 'env> -> WriterReaderT<'a, 's, 'env>
  end
  
  type WriterReaderBuilder<'s>(readerM : IReaderMonad, monoid : Monoid<'s>) = class end
    with interface IWriterReaderTrans<'s> with
                member s.Bind(m, f) =  WriterReaderT (readerM { let! (a', s') = run  m
                                                                let! (a'', s'') = run (f a')
                                                                return (a'', monoid.Append s' s'')
                                                              }) 
                member s.Let(a, f) =   f a
                member s.Return a = WriterReaderT (readerM.Return((a, monoid.Empty() )))
                member s.Delay f = f()
                member s.Lift(m) = WriterReaderT ( readerM { let! m' = m
                                                             return (m', monoid.Empty() )
                                                           })

  let WriterReaderT (monoid : Monoid<'s>) = new WriterReaderBuilder<'s>(readerM, monoid) :>  IWriterReaderTrans<'s>
 
